home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / mailcrypt / mc-toplev.el.z / mc-toplev.el
Encoding:
Text File  |  1998-05-21  |  19.3 KB  |  656 lines
  1. ;; mc-toplev.el, entry point functions for Mailcrypt
  2. ;; Copyright (C) 1995  Jin Choi <jsc@mit.edu>
  3. ;;                     Patrick LoPresti <patl@lcs.mit.edu>
  4.  
  5. ;;{{{ Licensing
  6. ;; This file is intended to be used with GNU Emacs.
  7.  
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;}}}
  22. ;;{{{ Load some required packages
  23. (require 'mailcrypt)
  24. (require 'mail-utils)
  25.  
  26. (eval-when-compile
  27.   ;; RMAIL
  28.   (condition-case nil (require 'rmail) (error nil))
  29.   (autoload 'rmail-abort-edit "rmailedit")
  30.   (autoload 'rmail-cease-edit "rmailedit")
  31.   ;; Is this a good idea?
  32.   (defvar rmail-buffer nil)
  33.  
  34.   ;; VM
  35.   (condition-case nil (require 'vm) (error nil))
  36.  
  37.   ;; GNUS
  38.   (condition-case nil (require 'gnus) (error nil))
  39.  
  40.   ;; MH-E
  41.   (condition-case nil (require 'mh-e) (error nil)))
  42.  
  43. (eval-and-compile
  44.   (condition-case nil (require 'mailalias) (error nil)))
  45.  
  46. (if (not mc-xemacs-p)
  47.     (autoload 'mc-scheme-pgp "mc-pgp" nil t))
  48.  
  49. ;;}}}
  50.  
  51. ;;{{{ Encryption
  52.  
  53. ;;;###autoload
  54. (defun mc-cleanup-recipient-headers (str)
  55.   ;; Takes a comma separated string of recipients to encrypt for and,
  56.   ;; assuming they were possibly extracted from the headers of a reply,
  57.   ;; returns a list of the address components.
  58.   (mapcar 'mc-strip-address
  59.       (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" str)))
  60.  
  61. (defun mc-find-headers-end ()
  62.   (save-excursion
  63.     (goto-char (point-min))
  64.     (re-search-forward
  65.      (concat "^" (regexp-quote mail-header-separator) "\n"))
  66.     (if (looking-at "^::\n")
  67.     (re-search-forward "^\n" nil t))
  68.     (if (looking-at "^##\n")
  69.     (re-search-forward "^\n" nil t))
  70.     (point-marker)))
  71.  
  72. ;;;###autoload
  73. (defun mc-encrypt (arg)
  74.   "*Encrypt the current buffer.
  75.  
  76. Exact behavior depends on current major mode.
  77.  
  78. With \\[universal-argument], prompt for User ID to sign as.
  79.  
  80. With \\[universal-argument] \\[universal-argument], prompt for encryption scheme to use."
  81.   (interactive "p")
  82.   (mc-encrypt-region arg nil nil))
  83.  
  84. (defun mc-encrypt-region (arg start end)
  85.   "*Encrypt the current region."
  86.   (interactive "p\nr")
  87.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  88.      (func (or (cdr-safe (assq 'encrypt mode-alist))
  89.            'mc-encrypt-generic))
  90.      sign scheme from)
  91.     (if (>= arg 4)
  92.     (setq from (read-string "User ID: ")
  93.           sign t))
  94.     (if (>= arg 16)
  95.     (setq scheme
  96.           (cdr (assoc
  97.             (completing-read "Encryption Scheme: " mc-schemes)
  98.             mc-schemes))))
  99.     (funcall func nil scheme start end from sign)))
  100.  
  101. (defun mc-encrypt-generic (&optional recipients scheme start end from sign)
  102.   "*Generic function to encrypt a region of data."
  103.   (save-excursion
  104.     (or start (setq start (point-min-marker)))
  105.     (or (markerp start) (setq start (copy-marker start)))
  106.     (or end (setq end (point-max-marker)))
  107.     (or (markerp end) (setq end (copy-marker end)))
  108.     (run-hooks 'mc-pre-encryption-hook)
  109.     (cond ((stringp recipients)
  110.        (setq recipients
  111.          (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)))
  112.       ((null recipients)
  113.        (setq recipients
  114.          (mc-cleanup-recipient-headers (read-string "Recipients: "))))
  115.       (t (error "mc-encrypt-generic: recipients not string or nil")))
  116.     (or scheme (setq scheme mc-default-scheme))
  117.     (if (funcall (cdr (assoc 'encryption-func (funcall scheme)))
  118.          recipients start end from sign)
  119.     (progn
  120.       (run-hooks 'mc-post-encryption-hook)
  121.       t))))
  122.  
  123. ;;;###autoload
  124. (defun mc-encrypt-message (&optional recipients scheme start end from sign)
  125.   "*Encrypt a message for RECIPIENTS using the given encryption SCHEME.
  126. RECIPIENTS is a comma separated string. If SCHEME is nil, use the value
  127. of `mc-default-scheme'.  Returns t on success, nil otherwise."
  128.   (save-excursion
  129.     (let ((headers-end (mc-find-headers-end))
  130.       default-recipients)
  131.  
  132.       (setq default-recipients
  133.         (save-restriction
  134.           (goto-char (point-min))
  135.           (re-search-forward
  136.            (concat "^" (regexp-quote mail-header-separator) "$"))
  137.           (narrow-to-region (point-min) (point))
  138.           (and (featurep 'mailalias)
  139.            (not (featurep 'mail-abbrevs))
  140.            mail-aliases
  141.            (expand-mail-aliases (point-min) (point-max)))
  142.           (mc-strip-addresses
  143.            (mapcar 'cdr
  144.                (mc-get-fields "to\\|cc\\|bcc")))))
  145.  
  146.       (if (not from)
  147.       (save-restriction
  148.         (goto-char (point-min))
  149.         (re-search-forward
  150.          (concat "^" (regexp-quote mail-header-separator) "\n"))
  151.         (narrow-to-region (point) headers-end)
  152.         (setq from (mail-fetch-field "From"))))
  153.       
  154.       (if (not recipients)
  155.       (setq recipients
  156.         (if mc-use-default-recipients
  157.             default-recipients
  158.           (read-from-minibuffer "Recipients: " default-recipients))))
  159.      
  160.       (or start (setq start headers-end))
  161.       (or end (setq end (point-max-marker)))
  162.  
  163.       (mc-encrypt-generic recipients scheme start end from sign))))
  164.       
  165.  
  166. ;;}}}
  167. ;;{{{ Decryption
  168.  
  169. ;;;###autoload
  170. (defun mc-decrypt ()
  171.   "*Decrypt a message in the current buffer.
  172.  
  173. Exact behavior depends on current major mode."
  174.   (interactive)
  175.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  176.      (func (or (cdr-safe (assq 'decrypt mode-alist))
  177.            'mc-decrypt-message)))
  178.     (funcall func)))
  179.  
  180. ;;;###autoload
  181. (defun mc-decrypt-message ()
  182.   "Decrypt whatever message is in the current buffer.
  183. Returns a pair (SUCCEEDED . VERIFIED) where SUCCEEDED is t if the encryption
  184. succeeded and VERIFIED is t if it had a valid signature."
  185.   (save-excursion
  186.     (let ((schemes mc-schemes)
  187.       limits scheme)
  188.       (while (and schemes
  189.           (setq scheme (cdr (car schemes)))
  190.           (not (setq
  191.             limits
  192.             (mc-message-delimiter-positions
  193.              (cdr (assoc 'msg-begin-line (funcall scheme)))
  194.              (cdr (assoc 'msg-end-line (funcall scheme)))))))
  195.     (setq schemes (cdr schemes)))
  196.       
  197.       (if (null limits)
  198.       (error "Found no encrypted message in this buffer.")
  199.     (run-hooks 'mc-pre-decryption-hook)
  200.     (let ((resultval (funcall (cdr (assoc 'decryption-func
  201.                           (funcall scheme))) 
  202.                   (car limits) (cdr limits))))
  203.       (goto-char (point-min))
  204.       (if (car resultval) ; decryption succeeded
  205.           (run-hooks 'mc-post-decryption-hook))
  206.       resultval)))))
  207. ;;}}}  
  208. ;;{{{ Signing
  209. ;;;###autoload
  210. (defun mc-sign (arg)
  211.   "*Sign a message in the current buffer.
  212.  
  213. Exact behavior depends on current major mode.
  214.  
  215. With one prefix arg, prompts for private key to use, with two prefix args,
  216. also prompts for encryption scheme to use.  With negative prefix arg,
  217. inhibits clearsigning (pgp)."
  218.   (interactive "p")
  219.   (mc-sign-region arg nil nil))
  220.  
  221. (defun mc-sign-region (arg start end)
  222.   "*Sign the current region."
  223.   (interactive "p\nr")
  224.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  225.      (func (or (cdr-safe (assq 'sign mode-alist))
  226.            'mc-sign-generic))
  227.      from scheme)
  228.     (if (>= arg 16)
  229.     (setq scheme
  230.           (cdr (assoc
  231.             (completing-read "Encryption Scheme: " mc-schemes)
  232.             mc-schemes))))
  233.     (if (>= arg 4)
  234.     (setq from (read-string "User ID: ")))
  235.  
  236.     (funcall func from scheme start end (< arg 0))))
  237.  
  238. (defun mc-sign-generic (withkey scheme start end unclearsig)
  239.   (or scheme (setq scheme mc-default-scheme))
  240.   (or start (setq start (point-min-marker)))
  241.   (or (markerp start) (setq start (copy-marker start)))
  242.   (or end (setq end (point-max-marker)))
  243.   (or (markerp end) (setq end (copy-marker end)))
  244.   (run-hooks 'mc-pre-signature-hook)
  245.   (if (funcall (cdr (assoc 'signing-func (funcall scheme)))
  246.            start end withkey unclearsig)
  247.       (progn
  248.     (run-hooks 'mc-post-signature-hook)
  249.     t)))
  250.  
  251. ;;;###autoload
  252. (defun mc-sign-message (&optional withkey scheme start end unclearsig)
  253.   "Clear sign the message."
  254.   (save-excursion
  255.     (let ((headers-end (mc-find-headers-end)))
  256.       (or withkey
  257.       (progn
  258.         (goto-char (point-min))
  259.         (re-search-forward
  260.          (concat "^" (regexp-quote mail-header-separator) "\n"))
  261.         (save-restriction
  262.           (narrow-to-region (point) headers-end)
  263.           (setq withkey (mail-fetch-field "From")))))
  264.       (or start (setq start headers-end))
  265.       (or end (setq end (point-max-marker)))
  266.       (mc-sign-generic withkey scheme start end unclearsig))))
  267.  
  268. ;;}}}
  269. ;;{{{ Signature verification
  270.  
  271. ;;;###autoload
  272. (defun mc-verify ()
  273.   "*Verify a message in the current buffer.
  274.  
  275. Exact behavior depends on current major mode."
  276.   (interactive)
  277.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  278.      (func (or (cdr-safe (assq 'verify mode-alist))
  279.            'mc-verify-signature)))
  280.     (funcall func)))
  281.  
  282. ;;;###autoload
  283. (defun mc-verify-signature ()
  284.   "*Verify the signature of the signed message in the current buffer.
  285. Show the result as a message in the minibuffer. Returns t if the signature
  286. is verified."
  287.   (save-excursion
  288.     (let ((schemes mc-schemes)
  289.       limits scheme)
  290.       (while (and schemes
  291.           (setq scheme (cdr (car schemes)))
  292.           (not
  293.            (setq
  294.             limits
  295.             (mc-message-delimiter-positions
  296.              (cdr (assoc 'signed-begin-line (funcall scheme)))
  297.              (cdr (assoc 'signed-end-line (funcall scheme)))))))
  298.     (setq schemes (cdr schemes)))
  299.  
  300.       (if (null limits)
  301.       (error "Found no signed message in this buffer.")
  302.     (funcall (cdr (assoc 'verification-func (funcall scheme)))
  303.          (car limits) (cdr limits))))))
  304.  
  305.  
  306. ;;}}}
  307. ;;{{{ Key management
  308.  
  309. ;;{{{ mc-insert-public-key
  310.  
  311. ;;;###autoload
  312. (defun mc-insert-public-key (&optional userid scheme)
  313.   "*Insert your public key at point.
  314. With one prefix arg, prompts for user id to use. With two prefix
  315. args, prompts for encryption scheme."
  316.   (interactive
  317.    (let (arglist)
  318.      (if (not (and (listp current-prefix-arg)
  319.            (numberp (car current-prefix-arg))))
  320.      nil
  321.        (if (>= (car current-prefix-arg) 16)
  322.        (setq arglist
  323.          (cons (cdr (assoc (completing-read "Encryption Scheme: "
  324.                             mc-schemes)
  325.                    mc-schemes))
  326.                arglist)))
  327.        (if (>= (car current-prefix-arg) 4)
  328.        (setq arglist (cons (read-string "User ID: ") arglist))))
  329.      arglist))
  330.  
  331. ;  (if (< (point) (mc-find-headers-end))
  332. ;      (error "Can't insert key inside message header"))
  333.   (or scheme (setq scheme mc-default-scheme))
  334.   (or userid (setq userid (cdr (assoc 'user-id (funcall scheme)))))
  335.     
  336.   ;; (goto-char (point-max))
  337.   (if (not (bolp))
  338.       (insert "\n"))
  339.   (funcall (cdr (assoc 'key-insertion-func (funcall scheme))) userid))
  340.  
  341. ;;}}}
  342. ;;{{{ mc-snarf-keys
  343.  
  344. ;;;###autoload
  345. (defun mc-snarf ()
  346.   "*Add all public keys in the buffer to your keyring.
  347.  
  348. Exact behavior depends on current major mode."
  349.   (interactive)
  350.   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
  351.      (func (or (cdr-safe (assq 'snarf mode-alist))
  352.            'mc-snarf-keys)))
  353.     (funcall func)))
  354.  
  355. ;;;###autoload
  356. (defun mc-snarf-keys ()
  357.   "*Add all public keys in the buffer to your keyring."
  358.   (interactive)
  359.   (let ((schemes mc-schemes)
  360.     (start (point-min))
  361.     (found 0)
  362.     limits scheme)
  363.     (save-excursion
  364.       (catch 'done
  365.     (while t
  366.       (while (and schemes
  367.               (setq scheme (cdr (car schemes)))
  368.               (not
  369.                (setq
  370.             limits
  371.             (mc-message-delimiter-positions
  372.              (cdr (assoc 'key-begin-line (funcall scheme)))
  373.              (cdr (assoc 'key-end-line (funcall scheme)))
  374.              start))))
  375.         (setq schemes (cdr schemes)))
  376.       (if (null limits)
  377.           (throw 'done found)
  378.         (setq start (cdr limits))
  379.         (setq found (+ found (funcall (cdr (assoc 'snarf-func
  380.                               (funcall scheme))) 
  381.                       (car limits) (cdr limits)))))))
  382.       (message (format "%d new key%s found" found
  383.                (if (eq 1 found) "" "s"))))))
  384. ;;}}}
  385. ;;}}}
  386. ;;{{{ Mode specific functions
  387.  
  388. ;;{{{ RMAIL
  389. ;;;###autoload
  390. (defun mc-rmail-summary-verify-signature ()
  391.   "*Verify the signature in the current message."
  392.   (interactive)
  393.   (if (not (eq major-mode 'rmail-summary-mode))
  394.       (error
  395.        "mc-rmail-summary-verify-signature called in inappropriate buffer"))
  396.   (save-excursion
  397.     (set-buffer rmail-buffer)
  398.     (mc-verify)))
  399.  
  400. ;;;###autoload
  401. (defun mc-rmail-summary-decrypt-message ()
  402.   "*Decrypt the contents of this message"
  403.   (interactive)
  404.   (if (not (eq major-mode 'rmail-summary-mode))
  405.       (error
  406.        "mc-rmail-summary-decrypt-message called in inappropriate buffer"))
  407.   (save-excursion
  408.     (set-buffer rmail-buffer)
  409.     (mc-decrypt)))
  410.  
  411. ;;;###autoload
  412. (defun mc-rmail-summary-snarf-keys ()
  413.   "*Adds keys from current message to public key ring"
  414.   (interactive)
  415.   (if (not (eq major-mode 'rmail-summary-mode))
  416.       (error
  417.        "mc-rmail-summary-snarf-keys called in inappropriate buffer"))
  418.   (save-excursion
  419.     (set-buffer rmail-buffer)
  420.     (mc-snarf)))
  421.  
  422. ;;;###autoload
  423. (defun mc-rmail-verify-signature ()
  424.   "*Verify the signature in the current message."
  425.   (interactive)
  426.   (if (not (equal mode-name "RMAIL"))
  427.       (error "mc-rmail-verify-signature called in a non-RMAIL buffer"))
  428.   ;; Hack to load rmailkwd before verifying sig
  429.   (rmail-add-label "verified")
  430.   (rmail-kill-label "verified")
  431.   (if (mc-verify-signature)
  432.       (rmail-add-label "verified")))
  433.  
  434. ;;;###autoload
  435. (defun mc-rmail-decrypt-message ()
  436.   "*Decrypt the contents of this message"
  437.   (interactive)
  438.   (let (decryption-result)
  439.     (if (not (equal mode-name "RMAIL"))
  440.     (error "mc-rmail-decrypt-message called in a non-RMAIL buffer"))
  441.     (unwind-protect
  442.     (progn
  443.       (rmail-edit-current-message)
  444.       (setq decryption-result (mc-decrypt-message))
  445.       (cond ((not (car decryption-result))
  446.          (rmail-abort-edit))
  447.         ((and (not (eq mc-always-replace 'never))
  448.               (or mc-always-replace
  449.               (y-or-n-p
  450.                "Replace encrypted message with decrypted? ")))
  451.          (rmail-cease-edit)
  452.          (rmail-kill-label "edited")
  453.          (rmail-add-label "decrypted")
  454.          (if (cdr decryption-result)
  455.              (rmail-add-label "verified")))
  456.         (t
  457.          (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
  458.            (copy-to-buffer tmp (point-min) (point-max))
  459.            (rmail-abort-edit)
  460.            (switch-to-buffer tmp t)
  461.            (goto-char (point-min))
  462.            (insert "From Mailcrypt-" mc-version " "
  463.                (current-time-string) "\n")
  464.            (rmail-convert-file)
  465.            (rmail-mode)
  466.            (use-local-map (copy-keymap (current-local-map)))
  467.            (local-set-key "q" 'mc-rmail-view-quit)
  468.            (set-buffer-modified-p nil)))))
  469.       (if (eq major-mode 'rmail-edit-mode)
  470.       (rmail-abort-edit)))))
  471.  
  472. (defun mc-rmail-view-quit ()
  473.   (interactive)
  474.   (let ((buf (current-buffer)))
  475.     (set-buffer-modified-p nil)
  476.     (rmail-quit)
  477.     (kill-buffer buf)))
  478.  
  479. ;;}}}
  480. ;;{{{ VM
  481. ;;;###autoload
  482. (defun mc-vm-verify-signature ()
  483.   "*Verify the signature in the current VM message"
  484.   (interactive)
  485.   (if (interactive-p)
  486.       (vm-follow-summary-cursor))
  487.   (vm-select-folder-buffer)
  488.   (vm-check-for-killed-summary)
  489.   (vm-error-if-folder-empty)
  490.   (save-restriction
  491.     (vm-widen-page)
  492.     (mc-verify-signature)))
  493.  
  494. ;;;###autoload
  495. (defun mc-vm-decrypt-message ()
  496.   "*Decrypt the contents of the current VM message"
  497.   (interactive)
  498.   (let ((vm-frame-per-edit nil)
  499.     from-line)
  500.     (if (interactive-p)
  501.     (vm-follow-summary-cursor))
  502.     (vm-select-folder-buffer)
  503.     (vm-check-for-killed-summary)
  504.     (vm-error-if-folder-read-only)
  505.     (vm-error-if-folder-empty)
  506.  
  507.     ;; store away a valid "From " line for possible later use.
  508.     (setq from-line (vm-leading-message-separator))
  509.     (vm-edit-message)
  510.     (cond ((not (condition-case condition-data
  511.             (car (mc-decrypt-message))
  512.           (error
  513.            (vm-edit-message-abort)
  514.            (error (message "Decryption failed: %s" 
  515.                    (car (cdr condition-data)))))))
  516.            (vm-edit-message-abort)
  517.        (error "Decryption failed."))
  518.       ((and (not (eq mc-always-replace 'never))
  519.         (or mc-always-replace
  520.             (y-or-n-p "Replace encrypted message with decrypted? ")))
  521.        (let ((this-command 'vm-edit-message-end))
  522.          (vm-edit-message-end)))
  523.           (t
  524.            (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
  525.              (copy-to-buffer tmp (point-min) (point-max))
  526.              (vm-edit-message-abort)
  527.              (switch-to-buffer tmp t)
  528.          (goto-char (point-min))
  529.          (insert from-line)         
  530.          (set-buffer-modified-p nil)
  531.          (vm-mode t))))))
  532.  
  533. ;;;###autoload
  534. (defun mc-vm-snarf-keys ()
  535.   "*Snarf public key from the contents of the current VM message"
  536.   (interactive)
  537.   (if (interactive-p)
  538.       (vm-follow-summary-cursor))
  539.   (vm-select-folder-buffer)
  540.   (vm-check-for-killed-summary)
  541.   (vm-error-if-folder-empty)
  542.   (save-restriction
  543.     (vm-widen-page)
  544.     (mc-snarf-keys)))
  545.  
  546. ;;}}}
  547. ;;{{{ GNUS
  548.  
  549. ;;;###autoload
  550. (defun mc-gnus-verify-signature ()
  551.   (interactive)
  552.   (gnus-summary-select-article)
  553.   (save-excursion
  554.     (set-buffer gnus-original-article-buffer)
  555.     (save-restriction (widen) (mc-verify-signature))))
  556.  
  557. ;;;###autoload
  558. (defun mc-gnus-snarf-keys ()
  559.   (interactive)
  560.   (gnus-summary-select-article)
  561.   (gnus-eval-in-buffer-window gnus-article-buffer
  562.     (save-restriction (widen) (mc-snarf-keys))))
  563.  
  564. ;;;###autoload
  565. (defun mc-gnus-decrypt-message ()
  566.   (interactive)
  567.   (gnus-summary-select-article)
  568.   ;; Gnus 5 has the string "Gnus" instead of "GNUS" in gnus-version.
  569.   (if (not (let ((case-fold-search nil))
  570.          (string-match "Gnus" gnus-version)))
  571.       (gnus-eval-in-buffer-window
  572.        gnus-article-buffer
  573.        (save-restriction (widen) (mc-decrypt-message)))
  574.     ;; Gnus 5 allows editing of articles.  (Actually, it makes a great
  575.     ;; mail reader.)
  576.     (gnus-eval-in-buffer-window gnus-article-buffer
  577.       (gnus-summary-edit-article t)
  578.       (save-restriction
  579.     (widen)
  580.     (cond ((not (car (mc-decrypt-message)))
  581.            (gnus-summary-edit-article-postpone))
  582.           ((and (not (gnus-group-read-only-p))
  583.             (not (eq mc-always-replace 'never))
  584.             (or mc-always-replace
  585.             (y-or-n-p
  586.              "Replace encrypted message on disk? ")))
  587.            (gnus-summary-edit-article-done))
  588.           (t
  589.            (gnus-summary-edit-article-postpone)))))))
  590.  
  591. ;;}}}        
  592. ;;{{{ MH
  593.  
  594. ;;;###autoload
  595. (defun mc-mh-decrypt-message ()
  596.   "Decrypt the contents of the current MH message in the show buffer."
  597.   (interactive "P")
  598.   (let* ((msg (mh-get-msg-num t))
  599.      (msg-filename (mh-msg-filename msg))
  600.      (show-buffer (get-buffer mh-show-buffer))
  601.      decrypt-okay decrypt-on-disk)
  602.     (setq
  603.      decrypt-on-disk
  604.      (and (not (eq mc-always-replace 'never))
  605.       (or mc-always-replace
  606.           (y-or-n-p "Replace encrypted message on disk? "))))
  607.     (if decrypt-on-disk
  608.     (progn
  609.       (save-excursion
  610.         (set-buffer (create-file-buffer msg-filename))
  611.         (insert-file-contents msg-filename t)
  612.         (if (setq decrypt-okay (car (mc-decrypt-message)))
  613.         (save-buffer)
  614.           (message "Decryption failed.")
  615.           (set-buffer-modified-p nil))
  616.         (kill-buffer nil))
  617.       (if decrypt-okay
  618.           (if (and show-buffer
  619.                (equal msg-filename (buffer-file-name show-buffer)))
  620.           (save-excursion
  621.             (save-window-excursion
  622.               (mh-invalidate-show-buffer)))))
  623.       (mh-show msg))
  624.       (mh-show msg)
  625.       (save-excursion
  626.     (set-buffer mh-show-buffer)
  627.     (if (setq decrypt-okay (car (mc-decrypt-message)))
  628.         (progn
  629.           (goto-char (point-min))
  630.           (set-buffer-modified-p nil))
  631.       (message "Decryption failed.")))
  632.       (if (not decrypt-okay)
  633.       (progn
  634.         (mh-invalidate-show-buffer)
  635.         (mh-show msg))))))
  636.  
  637. ;;;###autoload
  638. (defun mc-mh-verify-signature ()
  639.   "*Verify the signature in the current MH message."
  640.   (interactive)
  641.   (mh-show)
  642.   (mh-in-show-buffer (mh-show-buffer)
  643.     (mc-verify-signature)))
  644.     
  645.  
  646. ;;;###autoload
  647. (defun mc-mh-snarf-keys ()
  648.   (interactive)
  649.   (mh-show)
  650.   (mh-in-show-buffer (mh-show-buffer)
  651.     (mc-snarf-keys)))
  652.  
  653. ;;}}}
  654.  
  655. ;;}}}
  656.